home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / errpat.com / ERRPATCH.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1989-01-02  |  3.8 KB  |  74 lines
  1. PROGRAM ErrPatch;
  2.  
  3. { The following INLINE MACRO allows a procedure or function to generate }
  4. { a runtime-error with the address of the CALLING statement.            }
  5. { The ServiceRoutine must be FAR, otherwise the INLINE MACRO must be    }
  6. { modified to POP the caller's IP from stack, PUSH CS and PUSH the IP   }
  7. { again, as RunError expects a full SEGMENT:OFFSET address on stack     }
  8.  
  9. {NOV 18. 1988 , Per B. Larsen, Beta Computer Systems A/S, Frichsvej 40  }
  10. {               DK 8600 Silkeborg, DENMARK, Voice + 45 6 82 61 00       }
  11. {               Fax + 45 6 80 02 22, BBS +45 6 80 25 88                 }
  12. {               Telex 63203 PARNOR DK, CompuServe 75470,1320            }
  13.  
  14. PROCEDURE RunErrorPatchToCaller;
  15. INLINE($89/$EC/                 {     MOV  SP,BP Get rid of baseframe}
  16.        $5D/                     {     POP  BP    for this routine    }
  17.        $E8/00/00/               {     CALL LBL1  Only way to get IP  }
  18.        $5E/                     {LBL1:POP  SI    into register       }
  19.        $83/$C6/$0F/             {     ADD  SI,15 Adjust to point to  }
  20.                                 {                CALL RUNERROR instr.}
  21.        $0E/                     {     PUSH CS    Setup CODE SEGMENT  }
  22.        $07/                     {     POP  ES    addressability      }
  23.        $26/$C6/$04/$EA/         {     MOV  BYTE PTR ES:[SI],0EAh     }
  24.                                 {                Modify CALL instr.  }
  25.                                 {                generated by TURBO  }
  26.                                 {                to JMP FAR instr.   }
  27.        $90/                     {     NOP        Required to force   }
  28.        $90);                    {     NOP        read into CPU-cache }
  29.                                 {                AFTER patch         }
  30.  
  31. {Same as above, but reports the calling statement one level further up. }
  32. {You can expand the depth of "back-tracking" by copying the * marked    }
  33. {lines the desired number of times. Remember all PROCs/FUNCs must be FAR}
  34. {Alternatively you could rewrite the MACRO to take the number of POP-OFF}
  35. {levels as a parameter.}
  36.  
  37. PROCEDURE RunErrorPatchToCallerCaller;
  38. INLINE(
  39.        $89/$EC/                 {     MOV  SP,BP Get rid of baseframe   }
  40.        $5D/                     {     POP  BP    for this routine       }
  41.        $5E/                     {     POP  SI    Pop returnaddr       * }
  42.        $5E/                     {     POP  SI    for caller           * }
  43.        $89/$EC/                 {     MOV  SP,BP Get rid of baseframe * }
  44.        $5D/                     {     POP  BP    for previous routine * }
  45.        $E8/00/00/               {     CALL LBL1  Only way to get IP     }
  46.        $5E/                     {LBL1:POP  SI    into register          }
  47.        $83/$C6/$0F/             {     ADD  SI,15 Adjust to point to     }
  48.                                 {                CALL RUNERROR instr.   }
  49.        $0E/                     {     PUSH CS    Setup CODE SEGMENT     }
  50.        $07/                     {     POP  ES    addressability         }
  51.        $26/$C6/$04/$EA/         {     MOV  BYTE PTR ES:[SI],0EAh        }
  52.                                 {                Modify CALL instr.     }
  53.                                 {                generated by TURBO     }
  54.                                 {                to JMP FAR instr.      }
  55.        $90/                     {     NOP        Required to force      }
  56.        $90);                    {     NOP        read into CPU-cache    }
  57.                                 {                AFTER patch            }
  58. PROCEDURE ServiceRoutine;
  59. BEGIN
  60.   RunErrorPatchToCaller; {Do not put anything between this line and the
  61. next}
  62.   RunError(255);         {This instruction is patched by the previous
  63. line  }
  64. END;
  65.  
  66. PROCEDURE Caller;
  67. BEGIN
  68.   ServiceRoutine;
  69. END;
  70.  
  71. BEGIN
  72.   Caller;
  73. END.
  74.